home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TSR.SWG / 0019_Screen Saver.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  7KB  |  207 lines
  1. unit Scrnsavr;
  2. {$F+}
  3. (*************************************************************************)
  4. (*                        Screen Saver                                   *)
  5. (*                                                                       *)
  6. (*  Written by Jay A. Key -- Oct 1993                                    *)
  7. (*  Code may be modified and used freely.  Please mention my name        *)
  8. (*  somewhere in your docs or in the program itself.                     *)
  9. (*                                                                       *)
  10. (*  Self contained unit to install a text-mode screen saver in Turbo     *)
  11. (*  Pascal programs.  Simply include the following line in your code.    *)
  12. (*    uses ScrnSavr;                                                     *)
  13. (*                                                                       *)
  14. (*  It will initialize itself automatically, and will remove itself      *)
  15. (*  upon exit from your program, graceful exit or not.  Functions        *)
  16. (*  SetTimeOut and SetDelay are included if you wish to modify the       *)
  17. (*  default values.                                                      *)
  18. (*                                                                       *)
  19. (*  Warning: will not properly save and restore screens while running    *)
  20. (*  under the Turbo Pascal IDE.  Runs great from DOS.                    *)
  21. (*************************************************************************)
  22.  
  23. interface
  24.  
  25. uses
  26.   Dos, Crt;
  27.  
  28. function  NumRows : byte;          {Returns number of rows in current screen}
  29. function  ColorAdaptor : boolean;  {TRUE if color video card installed}
  30. procedure SetTimeOut(T : integer); {Delay(seconds) before activation}
  31. procedure SetDelay(T : integer);   {Interval between iterations}
  32.  
  33. implementation
  34.  
  35. type
  36.   VideoArray = array [1..2000] of word;  {buffer to save video screen}
  37.  
  38. var
  39.   Timer     : word;
  40.   Waiting   : boolean;
  41.   OldInt15,                  {Keyboard interrupt}
  42.   OldInt1C,                  {Timer interrupt}
  43.   OldInt23,                  {Cntl-C/Cntl-Break handler}
  44.   ExitSave  : pointer;
  45.   Position,
  46.   Cursor    : integer; {save and restore cursor positions}
  47.   VideoSave : VideoArray;
  48.   VideoMem  : ^VideoArray;
  49.   TimeOut,
  50.   Delay     : integer;
  51.  
  52. procedure JumpToPriorIsr(p : pointer);
  53. {Originally written by Brook Monroe, "An ISR Clock", pg. 64,
  54.  PC Techniques Aug/Sep 1992}
  55. inline($5b/$58/$87/$5e/$0e/$87/$46/$10/$89/$ec/$5d/$07/$1f/
  56.        $5f/$5e/$5a/$59/$cb);
  57.  
  58. function ColorAdaptor : boolean; assembler;
  59. asm
  60.   int 11                   {BIOS call - get equipment list}
  61.   and al,$0010             {mask off all but bit 4}
  62.   xor al,$0010             {flip bit 4 - return val is in al}
  63. end;
  64.  
  65. function NumRows : byte; assembler;  {returns number of displayable rows}
  66. asm
  67.   mov ax,$40
  68.   mov es,ax
  69.   mov ax,$84
  70.   mov di,ax
  71.   mov al,[es:di]           {byte at [$40:$84] is number of rows in display}
  72. end;
  73.  
  74. procedure HideCursor; assembler;
  75. asm
  76.   mov ah,$03
  77.   xor bh,bh
  78.   int $10               {video interrupt}
  79.   mov Position,dx       {save cursor position}
  80.   mov Cursor,cx         {and type}
  81.   mov ah,$01
  82.   mov ch,$20
  83.   int $10               {video interrupt - hide cursor}
  84. end;
  85.  
  86. procedure RestoreCursor; assembler;
  87. asm
  88.   mov ah,$02
  89.   xor bh,bh
  90.   mov dx,Position       {get old position}
  91.   int $10               {video interrupt - restore cursor position}
  92.   mov cx,Cursor         {get old cursor type}
  93.   mov ah,$01
  94.   int $10               {video interrupt - restore cursor type}
  95. end;
  96.  
  97. procedure RestoreScreen;
  98. begin
  99.   VideoMem^ := VideoSave;  {Copy saved image back onto video memory}
  100.   RestoreCursor;
  101. end;
  102.  
  103. procedure SaveScreen;
  104. begin
  105.   VideoSave := VideoMem^;  {Copy video memory to array}
  106.   HideCursor;
  107. end;
  108.  
  109. procedure DispMsg;  {simple stub-out for displaying YOUR message(s),
  110.                      pictures, etc...use your imagination!!!}
  111. begin
  112.   ClrScr;
  113.   GotoXY(random(50), random(23));
  114.   writeln('This would normally be something witty!');
  115. end;
  116.  
  117. procedure NewInt15(Flags,CS,IP,AX,BX,CX,DX,
  118.                    SI,DI,DS,ES,BP:WORD); interrupt; {keyboard handler}
  119. begin
  120.   Timer := 0;                     {Reset timer}
  121.   if Waiting then                 {Screen saver activated?}
  122.   begin
  123.     RestoreScreen;                {Restore saved screen image}
  124.     Waiting := FALSE;             {De-activate screen saver}
  125.     Flags   := (Flags and $FFFE); {Tell BIOS to ignore current keystroke}
  126.   end
  127.   else
  128.     JumpToPriorISR(OldInt15);   {call original int 15}
  129. end;
  130.  
  131. procedure NewInt1C; interrupt;    {timer interrupt}
  132. begin
  133.   Inc(Timer);                 {Increment timer}
  134.   if Timer > TimeOut then     {No key hit for TimeOut seconds?}
  135.   begin
  136.     Waiting := TRUE;          {Activate screen saver}
  137.     SaveScreen;               {Save image of video memory}
  138.     DispMsg;                  {Display your own message}
  139.     Timer := 0;               {Reset timer}
  140.   end;
  141.   if waiting then             {Is saver already active?}
  142.   begin
  143.     if Timer > Delay then     {Time for next message?}
  144.     begin
  145.       Timer := 0;             {Reset timer}
  146.       DispMsg;                {Display next message}
  147.     end;
  148.   end;
  149.   JumpToPriorISR(OldInt1C);   {Chain to old timer interrupt}
  150. end;
  151.  
  152. procedure ResetIntVectors;    {Restores Intrrupt vectors to orig. values}
  153. begin
  154.   SetIntVec($15, OldInt15);
  155.   SetIntVec($1C, OldInt1C);
  156.   SetIntVec($23, OldInt23);
  157. end;
  158.  
  159. procedure NewInt23; interrupt;{Called to handle cntl-c/brk}
  160. begin
  161.   ResetIntVectors;            {Restore old interrupt vectors}
  162.   JumpToPriorISR(OldInt23);   {Chain to original int 23h}
  163. end;
  164.  
  165. procedure MyExit; far;        {exit code for unit}
  166. begin
  167.   ResetIntVectors;            {Restore old interrupt vectors}
  168.   ExitProc := ExitSave;       {Restore old exit code}
  169. end;
  170.  
  171. procedure SetVideoAddress;    {Returns pointer to text video memory}
  172. begin
  173.   if ColorAdaptor then
  174.     VideoMem := ptr($B000, $0000)
  175.   else
  176.     VideoMem := ptr($B800, $0000);
  177. end;
  178.  
  179. procedure SetTimeOut(T : integer); {Set delay(seconds) before activation}
  180. begin
  181.   TimeOut := Round(T * 18.2);
  182. end;
  183.  
  184. procedure SetDelay(T : integer);  {Set interval between iterations}
  185. begin
  186.   Delay := Round(T * 18.2);
  187. end;
  188.  
  189. {Initialize unit}
  190. begin
  191.   SetVideoAddress;             {Set up address for video memory}
  192.   Waiting  := FALSE;            {Screen saver initially OFF}
  193.   Timer    := 0;                  {Reset timer}
  194.   ExitSave := ExitProc;        {Save old exit routine}
  195.   ExitProc := @MyExit;         {Install own exit routine}
  196.   {Install user defined int vectors}
  197.   GetIntVec($15, OldInt15);     {Keyboard handler}
  198.   SetIntVec($15, @NewInt15);
  199.   GetIntVec($1c, OldInt1C);     {Timer int}
  200.   SetIntVec($1c, @NewInt1C);
  201.   GetIntVec($23, OldInt23);     {Cntl-C/Brk handler}
  202.   SetIntVec($23, @NewInt23);
  203.   SetTimeOut(120);
  204.   SetDelay(15);
  205. end.
  206.  
  207.